Linux Cubed Series 3: Developer Tools/Linux Cubed Series 3 - Developer Tools.iso/devel/lang/lisp/stk-3.002/stk-3/STk-3.1/Src/tk-main.c

C/C++ Source or Header | 1996-07-23 | 4.8 KB | 184 lines

/*
 * t k - m a i n . c             -- Initialization of Tk
 *
 * This code initializes the Tk library. It corresponds to a part of the
 * file main.c of the wish interpreter.
 *
 *           Author: Erick Gallesio [[e-mail]]
 *    Creation date: 13-May-1993 10:59
 * Last file update: 23-Jul-1996 16:45
 *
 *
 * Code used here was originally copyrigthed as shown below:
 *      Copyright 1990-1992 Regents of the University of California.
 *
 *
 * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <[e-mail]>
 *
 *
 * Permission to use, copy, and/or distribute this software and its
 * documentation for any purpose and without fee is hereby granted, provided
 * that both the above copyright notice and this permission notice appear in
 * all copies and derived works.  Fees for distribution or use of this
 * software or derived works may only be charged with express written
 * permission of the copyright holder.
 * This software is provided ``as is'' without express or implied warranty.
 *
 * This software is a derivative work of other copyrighted softwares; the
 * copyright notices of these softwares are placed in the file COPYRIGHTS
 *
 */
#ifdef USE_TK
#include <signal.h>
#include "stk.h"


/*
 * Command used to initialize wish:
 */

static char initCmd[] = "(load (string-append *stk-library* \"/STk/tk-init.stk\"))";

/*
 * Global variables used by the main program:
 */

static Tk_Window w;            /* The main window for the application.  If
                      * NULL then the application no longer
                     * exists. */
Tcl_Interp *STk_main_interp= NULL;    /* Interpreter for this application. */
int Tk_initialized = 0;            /* 1 when Tk is fully initialized */

/*
 * Forward declarations for procedures defined later in this file:
 */

static void DelayedMap _ANSI_ARGS_((ClientData clientData));
static void StructureProc _ANSI_ARGS_((ClientData clientData,
                       XEvent *eventPtr));


/*
 *
 * Tcl-main
 *
 *  Perhaps, this procedure should be made available outside and the
 *  USE_TK conditionnal flags should be split in USE_TCL and USE_TK
 *
 */

static void Tcl_main(void)
{
  STk_main_interp = Tcl_CreateInterp();

  /* Initialize commands which are now in Tcl */
  Tcl_CreateCommand(STk_main_interp, "after",  Tcl_AfterCmd, NULL, NULL);
  Tcl_CreateCommand(STk_main_interp, "update", Tcl_UpdateCmd, NULL, NULL);

  /*
   * Vwait command can always be done with (tkwait 'variable ...).
   * So we don't define explicitely vwait
   * Note that "update" is also redefined by Tk4.1
   *
   * Tcl_CreateCommand(STk_main_interp, "vwait",  Tcl_VwaitCmd, NULL, NULL);
   *
   */
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_main
 *
 *----------------------------------------------------------------------
 */

void Tk_main(int synchronize, char *name, char *fileName, char *Xdisplay,
         char *geometry)
{
  char *p, *Class;
  int argc, code;
  char *args[20];

  Tcl_main();

  if (name == NULL) {
    p    = (fileName != NULL) ? fileName: STk_Argv0;
    name = strrchr(p, '/');
    if (name != NULL)
      name++;
    else
      name = p;
  }

  /*
   * Initialize the Tk application and arrange to map the main window
   * after the startup script has been executed, if any.  This way
   * the script can withdraw the window so it isn't ever mapped
   * at all.
   */
#ifdef FIXME
  Class = (char *) ckalloc((unsigned) (strlen(name) + 1));
  strcpy(Class, name);
  Class[0] = toupper((unsigned char) Class[0]);
#else
  Class = "STk";
#endif

#ifdef FIXME
  ckfree(Class);
#endif

  args[0] = "toplevel";
  args[1] = ".";
  args[2] = "-class";
  args[3] = Class;
  argc = 4;

  if (Xdisplay != NULL) {
    args[argc] = "-screen";
    args[argc+1] = Xdisplay;
    argc += 2;
  }

  if (STk_arg_colormap) {
    args[argc]   = "-colormap";
    args[argc+1] = "new";
    argc += 2;
  }
  if (STk_arg_visual != NULL) {
      args[argc] = "-visual";
      args[argc+1] = STk_arg_visual;
      argc += 2;
  }
  args[argc] = NULL;

  Tcl_ResetResult(STk_main_interp);

  code = TkCreateFrame((ClientData) NULL, STk_main_interp, argc, args, 1, name);
  if (code != TCL_OK) {
    panic(STk_main_interp->result);
  }

#ifndef WIN32
  if (synchronize) XSynchronize(Tk_Display(Tk_MainWindow(STk_main_interp)), TRUE);
#endif
  /* Set the geometry of the main window, if requested. */
  if (geometry != NULL) {
    if (TCL_OK != Tcl_VarEval(STk_main_interp, "(wm 'geometry *root* '",
                  geometry, ")", NULL))
      fprintf(STk_stderr, "**** Warning: %s\n", STk_main_interp->result);
  }
  code = TkPlatformInit(STk_main_interp);

  if (code == TCL_OK)
    Tk_initialized = 1;   /* Ok, it's fully initialized */

  STk_init_tracevar();     /* Initialize the variable tracing mechanism */
  STk_init_glue();

  /* Execute STk's initialization script */
  Tcl_GlobalEval(STk_main_interp, initCmd);
}
#endif /* USE_TK */